home *** CD-ROM | disk | FTP | other *** search
/ The 640 MEG Shareware Studio 4 / The 640 Meg Shareware Studio CD-ROM Volume IV (Data Express)(1994).ISO / clang / 120_01.zip / META42.C < prev    next >
Text File  |  1993-06-01  |  7KB  |  509 lines
  1. /* HEADER: CUG120.17;
  2.    TITLE: META4;
  3.    VERSION: 1.0;
  4.    DATE: 08/00/1981;
  5.    DESCRIPTION: "Dr. W.A. Gale's META4 compiler-compiler from DDJ August 1981";
  6.    KEYWORDS: compiler-compiler,programming languages;
  7.    SYSTEM: CP/M;
  8.    FILENAME: META43.C;
  9.    CRC: 5347;
  10.    AUTHORS: W.A.Gale, Jan Larsson;
  11.    COMPILERS: BDS C;
  12.    REFERENCES: AUTHORS: W.A.Gale; TITLE: "META4 Compiler-Compiler";
  13.     CITATION: "Doctor Dobb's Journal, August 1981" ENDREF;
  14. */
  15.  
  16. #include "meta40.h"
  17.  
  18. #define BOOLA aa = TRUE ; else aa = FALSE
  19. #define BOOLB bb = TRUE ; else bb = FALSE
  20. #define BOOLE ee = TRUE ; else ee = FALSE
  21.  
  22.  
  23.  
  24. fra()
  25. {
  26.     
  27.     os[c0]=cc;
  28.     po = 1 ;
  29.     while(TRUE){
  30.         cc = gchar( f1 );
  31.         fza();
  32.         dd = aa ;
  33.         fzn();
  34.         aa = aa | dd ;
  35.         if(!aa)break;
  36.         os[po] = cc ;
  37.         po++;
  38.         }
  39.     
  40.     if(cc == nl)BOOLA;
  41.     if(aa);else {
  42.         while(TRUE){
  43.             cc = gchar( f1 );
  44.             if(cc != nl)BOOLA;
  45.             if(!aa)break;
  46.             }
  47.         }
  48. }
  49.  
  50.  
  51.  
  52. frc()
  53. {
  54.     
  55.     xclose( f1 );
  56.     ibk = iav[c1] ;
  57.     xopen(ibk, f1);
  58.     fck();
  59.     ipc = 1 ;
  60.     ll = ipl = 0 ;
  61.     while(TRUE){
  62.         rc = gchar( f1 );
  63. loc33:
  64.         if(er == c0)BOOLA;
  65.         if(!aa)break;
  66.         switch (rc) {
  67.             case '/' : 
  68.                 cc = gchar( f1 );
  69.                 if(cc == '-')BOOLA;
  70.                 if(aa){ 
  71.                     cc = gchar( f1 );
  72.                     frn();
  73.                     irn = -irn ;
  74.                     goto loc37;
  75.                     }
  76.                 else ;
  77.                 fzn();
  78.                 if(aa){ 
  79.                     frn();
  80. loc37:
  81.                     unpack(&irn,&aa,&bb);
  82.                     ks[ipc] = aa ;
  83.                     ipc++;
  84.                     ll++;
  85.                     ks[ipc] = bb ;
  86.                     ipc++;
  87.                     ll++;
  88.                     rc = cc ;
  89.                     if(rc == ' ')BOOLA;
  90.                     if(aa);else goto loc33;
  91.                     }
  92.                 else {
  93.                     ks[ipc] = '/' ;
  94.                     ipc++;
  95.                     ll++ ;
  96.                     rc = cc ;
  97.                     goto loc33;
  98.                     }
  99.                 break;
  100.             case '\n' : 
  101.                 ks[ipl] = ll ;
  102.                 ipl = ipc ;
  103.                 ipc++;
  104.                 ll = c0 ;
  105.                 break;
  106.             case '.' : 
  107.                 if(ll == c0)BOOLA;
  108.                 if(aa){
  109.                     frl();
  110.                     rc = '\n';
  111.                     ipc-- ;
  112.                     goto loc33;
  113.                     }
  114.                 else goto loc35;
  115.                 break;
  116.             case 'g' : 
  117.                 if(ll == c0)BOOLA;
  118.                 if(aa){
  119.                     cc = gchar( f1 );
  120.                     fra();
  121.                     os[po] = c0 ;
  122.                     fme();
  123.                     irn = imi[iaa];
  124.                     if(irn == i00)BOOLA;
  125.                     if(aa){
  126.                         irn = iaa ;
  127.                         ks[ipc] = nl ;
  128.                         }
  129.                     else ks[ipc] = rc ;
  130.                     ipc++;
  131.                     unpack(&irn,&aa,&bb);
  132.                     ks[ipc] = aa ;
  133.                     ipc++;
  134.                     ks[ipc] = bb ;
  135.                     ipc++;
  136.                     ll = c3 ;
  137.                     rc = nl ;
  138.                     goto loc33;
  139.                     }
  140.                 else goto loc35;
  141.                 break;
  142.             default:
  143.                 aa = aa ;
  144. loc35:
  145.                 ks[ipc] = rc ;
  146.                 ipc++;
  147.                 ll++;
  148.             }
  149.         }
  150.     ipc-- ;
  151.     if(er != c1)BOOLA;
  152.     if(aa){
  153.         puts("Cant read commands.\n");
  154.         exit();
  155.         }
  156.     else ;
  157.     xclose( f1 );
  158.     ibk = iav[ c2 ];
  159.     xopen(ibk, f1 );
  160.     fck();
  161.     iaa = 0 ;
  162.     while(TRUE){
  163.         if(iaa < ipc)BOOLA;
  164.         if(!aa)break;
  165.         ll = ks[iaa];
  166.         ibb = iaa + i01 ;
  167.         aa = ks[ibb];
  168.         if(aa == nl)BOOLA;
  169.         if(aa){ 
  170.             ks[ibb] = xg ;
  171.             ibb++;
  172.             aa = ks[ibb];
  173.             ibb++;
  174.             bb = ks[ibb];
  175.             pack(&irn,&aa,&bb);
  176.             bb = mc[irn];
  177.             if(bb != c1)BOOLA;
  178.             if(aa){ 
  179.                 icc = irn - i10 ;
  180.                 while(TRUE){
  181.                     if(icc < irn)BOOLA;
  182.                     if(!aa)break;
  183.                     bb = mc[icc];
  184.                     putchar( bb );
  185.                     icc++;
  186.                     }
  187.                 putchar( cb );
  188.                 puts("Subroutine undefined.\n");
  189.                 }
  190.             else ;
  191.             icc = imi[irn];
  192.             unpack(&icc,&aa,&bb);
  193.             ks[ibb] = bb ;
  194.             ibb-- ;
  195.             ks[ibb] = aa ;
  196.             }
  197.         else ;
  198.         ibb = ll ;
  199.         iaa = iaa + ibb ;
  200.         iaa = iaa + i01 ;
  201.         }
  202.     fmp();
  203.     iaa = ipc;
  204.     fpn();
  205.     puts("command bytes ");
  206.     iaa = inl ;
  207.     fpn();
  208.     puts("number labels ");
  209.     iaa = pn ;
  210.     fpn();
  211.     puts("subroutines ");
  212.     putchar( '\n' );
  213. }
  214.  
  215.  
  216.  
  217. frl()
  218. {
  219.     
  220.     while(TRUE){
  221.         cc = gchar( f1 );
  222.         fza();
  223.         if(aa)goto loc80; else ;
  224.         fzn();
  225.         if(aa)goto loc85; else ;
  226.         if(cc != nl)BOOLA;
  227.         if(!aa)break;
  228.         }
  229.     return;
  230. loc80:
  231.     fra();
  232.     os[po] = c0 ;
  233.     fme();
  234.     imi[iaa] = ipl ;
  235.     mc[iaa] = c1 ;
  236.     pn++;
  237.     return;
  238. loc85:
  239.     inl++;
  240.     frn();
  241.     ilt[irn] = ipl ;
  242. }
  243.  
  244.  
  245.             
  246.  
  247. frn()
  248. {
  249.     
  250.     irn = 0 ;
  251.     while(TRUE){
  252.         cc = cc - x0 ;
  253.         iaa = cc ;
  254.         irn = irn * 10 ;
  255.         irn = irn + iaa ;
  256.         cc = gchar( f1 );
  257.         fzn();
  258.         if(!aa)break;
  259.         }
  260. }
  261.  
  262.  
  263.  
  264.  
  265. fst()
  266. {
  267.     
  268.     qi++;
  269.     cc = ri[qi];
  270.     switch (cc ) {
  271.         case 'y' : 
  272.             yp++;
  273.             if(sd <= yp)BOOLA;
  274.             if(aa){
  275.                 puts("Y overflow.\n");
  276.                 yp = sd ;
  277.                 fl = 0 ;
  278.                 }
  279.             else ;
  280.             iys[yp] = itu ;
  281.             break;
  282.         case 'z' : 
  283.             zp++;
  284.             if(sd <= zp)BOOLA;
  285.             if(aa){
  286.                 puts("Z overflow.\n");
  287.                 zp = sd ;
  288.                 fl = 0 ;
  289.                 }
  290.             else ;
  291.             izs[zp] = itu ;
  292.             break;
  293.         case '+' : 
  294.             iaa = iys[yp];
  295.             iaa = iaa + itu ;
  296.             iys[yp] = iaa ;
  297.             break;
  298.         case '-' : 
  299.             iaa = iys[yp];
  300.             iaa = iaa - itu ;
  301.             iys[yp] = iaa ;
  302.             break ;
  303.         case '*' : 
  304.             iaa = iys[yp];
  305.             iaa = iaa * itu ;
  306.             iys[yp] = iaa ;
  307.             break ;
  308.         case '>' : 
  309.             iaa = iys[yp];
  310.             if(iaa < itu)BOOLA;
  311. loc12:
  312.             if(aa)fl = 1 ; else fl = 0 ;
  313.             fpy();
  314.             break;
  315.         case '<' :
  316.             iaa = iys[yp];
  317.             if(itu < iaa)BOOLA;
  318.             goto loc12;
  319.             break;
  320.         case '=' :
  321.             iaa = iys[yp];
  322.             if(iaa == itu)BOOLA;
  323.             goto loc12;
  324.         case 'i' : 
  325.             qi++;
  326.             dd = ri[qi];
  327.             ibb = itu;
  328.             qi++;
  329.             fft();
  330.             cc = dd ;
  331.             fzn();
  332.             if(aa)bb = cc - x0 ; 
  333.             else {
  334. loc13:
  335.                 puts("Bad indirect index.\n");
  336.                 bb = 0 ;
  337.                 }
  338.             if(bb < mk)BOOLA;
  339.             if(aa){
  340.                 iaa = bb ;
  341.                 iaa = iaa + itu ;
  342.                 imi[iaa] = ibb ;
  343.                 return;
  344.                 }
  345.             else {
  346.                 bb = bb - mk ;
  347.                 if(bb < mk)BOOLA;
  348.                 if(aa){
  349.                     iaa = bb ;
  350.                     iaa = itu + iaa ;
  351.                     aa = ibb ;
  352.                     mc[iaa] = aa ;
  353.                     }
  354.                 else goto loc13;
  355.                 }
  356.             break;
  357.         case 'c' : 
  358.             iaa = itu ;
  359.             fwn();
  360.             break;
  361.         case 'l' : 
  362.             aa = itu;
  363.             bo[pb] = aa ;
  364.             pb++;
  365.             break;
  366.         case 'a' : 
  367.             aa = itu ;
  368.             os[po] = aa ;
  369.             po++;
  370.             os[po] = c0 ;
  371.             break;
  372.         case 'b' : 
  373.             po = itu ;
  374.             os[po] = c0 ;
  375.             break;
  376.         case 'g' : 
  377.             iuu = itu ;
  378.             break;
  379.         case 'u' : 
  380.             iaa = ipt ;
  381. loc39:
  382.             iaa++;
  383.             ist[iaa] = itu ;
  384.             break;
  385.         case 'v' : 
  386.             iaa = ipt ;
  387.             iaa++;
  388.             goto loc39;
  389.             break;
  390.         case 'd' : 
  391.             break;
  392.         case 'h' : 
  393.             aa = itu ;
  394.             itu = aa ; 
  395.             iaa = itu / 16 ;
  396.             ibb = iaa * 16 ;
  397.             ibb = itu - ibb ;
  398.             cc = iaa ;
  399.             fwh();
  400.             cc = ibb ;
  401.             fwh();
  402.             break;
  403.         default : 
  404.             cc = ri[qi];
  405.             fzn();
  406.             if(aa)aa = cc - x0 ;
  407.             else {
  408.                 puts("Illegal store.\n");
  409.                 aa = c0 ;
  410.                 }
  411.             ipr[aa] = itu ;
  412.         }
  413. }
  414.  
  415.  
  416.  
  417. fwh()
  418. {
  419.     
  420.     if(cc <= 9)BOOLA;
  421.     if(aa)cc = cc + '0' ;
  422.     else cc = cc + 'a' + 7 ;
  423.     bo[pb] = cc ;
  424.     pb++;
  425. }
  426.  
  427.  
  428. fwn()
  429. {
  430.     
  431.     fds();
  432.     while(TRUE){
  433.         ibb = nd ;
  434.         if(i00 < ibb)BOOLA;
  435.         if(!aa)break;
  436.         nd--;
  437.         aa = ds[nd];
  438.         bo[pb] = aa ;
  439.         pb++;
  440.         }
  441. }
  442.  
  443.  
  444. fza()
  445. {
  446.     
  447.     aa = cc - 'a' ;
  448.     bb = 'z' - cc ;
  449.     if(aa <= cv)BOOLA;
  450.     if(bb <= cv)BOOLB;
  451.     aa = aa & bb ;
  452. }
  453.  
  454.  
  455. fzh()
  456. {
  457.     
  458.     if('0' <= cc)BOOLA;
  459.     if(cc <= '9')BOOLB;
  460.     aa = aa & bb ;
  461.     if(aa){
  462.         cc = cc - '0' ;
  463.         return;
  464.         }
  465.     else ;
  466.     if('a' <= cc)BOOLA;
  467.     if(cc <= 'f')BOOLB;
  468.     aa = aa & bb ;
  469.     if(aa){
  470.         cc = cc - 'a' ;
  471.         bb = 10 ;
  472.         cc = cc + bb ;
  473.         return;
  474.         }
  475.     else ;
  476. }
  477.  
  478.  
  479.  
  480.  
  481. fzn()
  482. {
  483.     
  484.     aa = cc - '0' ;
  485.     bb = '9' - cc ;
  486.     if(aa <= 9)BOOLA;
  487.     if(bb <= 9)BOOLB;
  488.     aa = aa & bb ;
  489. }
  490.  
  491.  
  492. fzw()
  493. {
  494.     
  495.     if(cc == ' ')BOOLA;
  496.     if(cc == '\t')BOOLB;
  497.     aa = aa | bb ;
  498.     if(cc == '\n')BOOLB;
  499.     aa = aa | bb ;
  500. }
  501.  
  502.  
  503.     
  504.                 }
  505.             if(bb < mk)BOOLA;
  506.             if(aa){
  507.                 iaa = bb ;
  508.                 iaa = iaa + itu ;
  509.                 imi[